home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_exim.idb / usr / freeware / bin / exiqsumm.z / exiqsumm
Encoding:
Text File  |  1999-01-26  |  2.5 KB  |  113 lines
  1. #! /usr/bin/perl -w
  2.  
  3. # Mail Queue Summary
  4. # Christoph Lameter, 21 May 1997
  5. # Modified by Philip Hazel, June 1997
  6. # Bug fix: June 1998 by Philip Hazel
  7. #   Message sizes not listed by -bp with K or M
  8. #   suffixes were getting divided by 10.
  9. #
  10. # Usage: mailq | exiqsumm [-a] [-c]
  11. #   Default sorting is by domain name
  12. #   -a sorts by age of oldest message
  13. #   -c sorts by count of message
  14.  
  15. # Slightly modified sub from eximstats
  16.  
  17. sub print_volume_rounded {
  18. my($x) = pop @_;
  19. if ($x < 10000)
  20.   {
  21.   return sprintf("%6d", $x);
  22.   }
  23. elsif ($x < 10000000)
  24.   {
  25.   return sprintf("%4dKB", ($x + 512)/1024);
  26.   }
  27. else
  28.   {
  29.   return sprintf("%4dMB", ($x + 512*1024)/(1024*1024));
  30.   }
  31. }
  32.  
  33. sub s_conv {
  34.   my($x) = @_;
  35.   my($v,$s) = $x =~ /([\d\.]+)([A-Z]|)/;
  36.   if ($s eq "K") { return $v * 1024 };
  37.   if ($s eq "M") { return $v * 1024 * 1024 };
  38.   return $v;
  39. }
  40.  
  41. sub older {
  42.   my($x1,$x2) = @_;
  43.   my($v1,$s1) = $x1 =~ /(\d+)(\w)/;
  44.   my($v2,$s2) = $x2 =~ /(\d+)(\w)/;
  45.   return $v1 > $v2 if ($s1 eq $s2);
  46.   return ($s2 eq "m") ||
  47.          ($s2 eq "h" && $s1 eq "d") ||
  48.          ($s2 eq "d" && $s1 eq "w");
  49. }
  50.  
  51. #
  52. # Main Program
  53. #
  54.  
  55. $sort_by_count = 0;
  56. $sort_by_age = 0;
  57.  
  58. while (@ARGV > 0 && substr($ARGV[0], 0, 1) eq "-")
  59.   {
  60.   if ($ARGV[0] eq "-a") { $sort_by_age = 1; }
  61.   if ($ARGV[0] eq "-c") { $sort_by_count = 1; }
  62.   shift @ARGV;
  63.   }
  64.  
  65. while (<>)
  66. {
  67. # Skip already delivered lines
  68.  
  69. if (/\s*D\s\S+/) { next; }
  70.  
  71. # If it's the first line of a message, pick out the data. Note: it may
  72. # have text after the final > (e.g. frozen) so don't insist that it ends >.
  73.  
  74. if (/^([\d\s]{2}\w)\s+(\S+)\s(\S+)\s\<(\S*)\>/)
  75.   {
  76.   ($age,$size,$id)=($1,$2,$3);
  77.   }
  78.  
  79. # Else check for a recipient line: to handle source-routed addresses, just
  80. # pick off the first domain.
  81.  
  82. elsif (/^\s+[^@]*\@([\w\d\.\-]*)/)
  83.   {
  84.   $domain = "\L$1";
  85.   $queue{$domain}++;
  86.   $q_oldest{$domain} = $age
  87.     if (!defined $q_oldest{$domain} || &older($age,$q_oldest{$domain}));
  88.   $q_recent{$domain} = $age
  89.     if (!defined $q_recent{$domain} || &older($q_recent{$domain},$age));
  90.   $q_size{$domain} = 0 if (!defined $q_size{$domain});
  91.   $q_size{$domain} += &s_conv($size);
  92.   }
  93. }
  94.  
  95. print "\nCount  Volume  Oldest  Newest  Domain";
  96. print "\n-----  ------  ------  ------  ------\n\n";
  97.  
  98. foreach $id (sort
  99.             {
  100.             $sort_by_age? &older($q_oldest{$b}, $q_oldest{$a}) :
  101.             $sort_by_count? ($queue{$b} <=> $queue{$a}) :
  102.             $a cmp $b
  103.             }
  104.             keys %queue)
  105.   {
  106.   printf("%5d  %.6s  %6s  %6s  %.80s\n",
  107.     $queue{$id}, &print_volume_rounded($q_size{$id}), $q_oldest{$id},
  108.     $q_recent{$id}, $id);
  109.   }
  110. print "\n";
  111.  
  112. # End
  113.